home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
helpdb.src
< prev
next >
Wrap
Text File
|
1990-10-17
|
5KB
|
169 lines
%%HP: T(3)A(D)F(.);
@ by Scotty Thompson
DIR
HELP
\<< CLLCD DEPTH 0 \-> dep gn
\<< 1 CF
IF dep 0 ==
THEN "NO OBJECTS ON STACK." 1 SF
ELSE DUP
IF TYPE 6 \=/
THEN "INVALID OBJECT TYPE." 1 SF
END
END
DO 2 CF 4 CF 6 CF
WHILE 1 FS?C
REPEAT
IF 6 FC?C
THEN "\010\010"
ELSE "\010"
END " ENTER GLOBAL NAME:" + + "" INPUT REMSP "'" + "'" SWAP + DUP
IF "''" ==
THEN DROP KILL
END DUP
IF "'PURGE'" ==
THEN DROP "0"
IF 2 FS?
THEN 2 CF
ELSE 2 SF
END 3 SF
END DUP
IF "'DEFINE'" ==
THEN DROP "0"
IF 4 FS?
THEN 4 CF
ELSE 4 SF
END 5 SF
END
IFERR OBJ\->
THEN DROP 0
END
IFERR DUP
THEN 0 0
END
IF TYPE 6 \=/
THEN DROP
IF 3 FC? 5 FC? AND
THEN "INVALID OBJECT TYPE."
ELSE
IF 3 FS?C THEN ""
IF 4 FS?C
THEN DROP 6 SF "DEFINE CANCELED.\010"
END
IF 2 FS?
THEN "PURGE HELP TEXT."
ELSE "PURGE CANCELED."
END +
END
IF 5 FS?C
THEN ""
IF 2 FS?C
THEN DROP 6 SF "PURGE CANCELED.\010"
END
IF 4 FS?
THEN "DEFINE HELP TEXT."
ELSE "DEFINE CANCELED."
END +
END
END 1 SF
END
END 'gn' STO gn VTYPE 1 + DUP
IF NOT
THEN DROP 1 SF
END "NAME: " gn \->STR +
IF 4 FS?
THEN DUP
IF 1 FS?
THEN "NO "
ELSE "DEFINE "
END SWAP + "\010\010ENTER TEXT \<= 48 CHRS:" + "" INPUT 1 48 SUB
REMCR DUP
IF "" ==
THEN DROP
ELSE gn \->STR SWAP + 1 CHR +
IFERR :0: XXXHELP RCL NEWOB
THEN DROP ""
END DUP
IF gn \->STR POS NOT
THEN SWAP + :0: XXXHELP DUP PURGE STO
ELSE DROP2
END
END
END
IF 1 FS?
THEN "\010TYPE: UNDEFINED \010SIZE: UNDEFINED \010 CRC: UNDEFINED" +
ELSE SWAP { "REAL" "COMPLEX" "STRING" "REAL ARRAY" "COMPLEX ARRAY"
"LIST" "GLOBAL NAME" "LOCAL NAME" "PROGRAM" "ALGEBRAIC"
"BINARY INTEGER" "GRAPHICS OBJECT" "TAGGED OBJECT" "UNIT OBJECT"
"XLIB NAME" "DIRECTORY" "LIBRARY" "BACKUP OBJECT" "FUNCTION"
"COMMAND" } SWAP GET "\010TYPE: " SWAP + + "\010SIZE: " gn BYTES
\->STR SWAP "\010 CRC: " SWAP \->STR + + + +
END 10 CF "\010TEXT: "
IFERR :0: XXXHELP RCL NEWOB
THEN DROP "NONE" 10 SF
END
IF 10 FC?C
THEN DUP gn \->STR POS DUP
IF NOT
THEN DROP2 "NONE"
ELSE
IF 2 FS?C
THEN DUP
IF 1 ==
THEN DROP DUP 1 CHR POS 1 + SWAP DUP SIZE ROT SWAP SUB
:0: XXXHELP DUP PURGE STO "PURGED" END
ELSE gn \->STR SIZE + SWAP DUP SIZE ROT SWAP SUB DUP 1 CHR POS
1 - 1 SWAP SUB 1 48 SUB REMCR DUP 1 16 SUB SWAP DUP 17 32 SUB
SWAP 33 48 SUB "\010 " SWAP + + "\010 " SWAP + +
END
END
END + + DUP CLLCD 0 DISP
DO 0 WAIT DUP
IF 21.2 ==
THEN DROP WON " H E L P" WOFF + + PR1 DROP CR PR1 CR
" - - - - - - - - - - " PR1 DROP CR CR CR 0
END
UNTIL IP 51 ==
END DROP CLLCD "PRESS ENTER TO END." 1 SF
UNTIL 0
END
\>>
\>>
REMCR @ remove carriage returns
\<< 3 CF
DO DUP
IF "\010" POS DUP
THEN DUP
IF 1 ==
THEN DROP DUP SIZE 2 SWAP SUB
ELSE SWAP DUP 1 4 PICK 1 - SUB SWAP 3 PICK 1 + OVER SIZE SUB + SWAP
DROP
END
ELSE DROP 3 SF
END
UNTIL 3 FS?C
END
\>>
REMSP @ remove spaces
\<< 3 CF
DO DUP
IF " " POS DUP
THEN DUP
IF 1 ==
THEN DROP DUP SIZE 2 SWAP SUB
ELSE SWAP DUP 1 4 PICK 1 - SUB SWAP 3 PICK 1 + OVER SIZE SUB + SWAP
DROP
END
ELSE DROP 3 SF
END
UNTIL 3 FS?C
END
\>>
WOFF @ wide off
\<< 27 CHR 252 CHR +
\>>
WON @ wide on
\<< 27 CHR 253 CHR +
\>>
END